home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / dired / dired-cd.el < prev    next >
Encoding:
Text File  |  1994-09-20  |  9.7 KB  |  220 lines
  1. ;;; -*- Mode: Emacs-lisp -*- ;;;
  2. ;;; dired-cd.el - Adjust Working Directory for Tree Dired Shell Commands 
  3. ;;; Id: dired-cd.el,v 1.14 1991/11/01 14:28:27 sk RelBeta 
  4. ;;; Copyright (C) 1991 Hugh Secker-Walker
  5. ;;;
  6. ;;; Author:  Hugh Secker-Walker   hugh@ear-ache.mit.edu
  7. ;;;
  8. ;;; Modified by Sebastian Kremer <sk@thp.uni-koeln.de>
  9. ;;;
  10. ;;; This program is free software; you can redistribute it and/or modify
  11. ;;; it under the terms of the GNU General Public License as published by
  12. ;;; the Free Software Foundation; either version 1, or (at your option)
  13. ;;; any later version.
  14. ;;;
  15. ;;; This program is distributed in the hope that it will be useful,
  16. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. ;;; GNU General Public License for more details.
  19. ;;;
  20. ;;; A copy of the GNU General Public License can be obtained from this
  21. ;;; program's author (send electronic mail to the above address) or from
  22. ;;; Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  25. ;;    LCD Archive Entry:
  26. ;;    dired-cd|Hugh Secker-Walker|hugh@ear-ache.mit.edu
  27. ;;    |Adjust Working Directory for Tree Dired Shell Commands 
  28. ;;    |Date: 1991/11/01 14:28:27 |Revision: 1.14 |
  29.  
  30. ;;; SUMMARY
  31.  
  32. ;;; This extension to Sebastian Kremer's (sk@thp.Uni-Koeln.DE) Tree-Dired
  33. ;;; permits the working directory of the dired shell commands
  34. ;;; dired-do-shell-command and dired-do-background-shell-command
  35. ;;; to be the files' subdirectory under certain circumstances.
  36. ;;; Loading this extension does not change the behavior of dired until
  37. ;;; the variables dired-cd-same-subdir and/or dired-cd-on-each are
  38. ;;; non-nil.  
  39.  
  40.  
  41. ;;; FUNCTIONALITY PROVIDED
  42.  
  43. ;;; If dired-cd-same-subdir is non-nil and if all the selected files
  44. ;;; (marked, non-zero numeric ARG, etc.) are in the same directory, then
  45. ;;; dired-do-shell-command and dired-do-background-shell-command will
  46. ;;; cause the shell to perform a cd into that directory before the
  47. ;;; commands are executed.  Also, the selected filenames will be provided
  48. ;;; to the command without any directory components.
  49.  
  50. ;;; If dired-cd-on-each is non-nil and if the on-each option is specified
  51. ;;; (numeric arg of zero), then dired-do-shell-command and
  52. ;;; dired-do-background-shell-command will perform a cd into the
  53. ;;; directory of each file before the commands on that file are executed.
  54. ;;; Also, each filename will be provided to the command without any
  55. ;;; directory components.  Note that this on-each behavior occurs
  56. ;;; regardless of whether the files are all in the same directory or not.
  57.  
  58. ;;; After the above "cd wrapping" has occured, the existing
  59. ;;; dired-shell-stuff-it is used to do file-name substitution and
  60. ;;; quoting, so custom versions of this procedure should work, e.g.
  61. ;;; dired-trans will transform commands correctly.  However, since
  62. ;;; filenames lack any directory components, features that use the
  63. ;;; directory components will fail, e.g. the dired-trans [d] transform
  64. ;;; specifier will be empty.
  65.  
  66. ;;; New variables (user options):
  67. ;;;    dired-cd-same-subdir
  68. ;;;    dired-cd-on-each
  69. ;;;
  70. ;;; Replaces procedures:
  71. ;;;    dired-do-shell-command  (new doc and prompt, calls dired-cd-wrap-it)
  72. ;;;
  73. ;;; Adds procedures:
  74. ;;;    dired-cd-wrap-it  (wraps calls to dired-shell-stuff-it with "cd <dir>")
  75. ;;;    dired-files-same-directory
  76.  
  77.  
  78. ;; INSTALLATION
  79. ;;
  80. ;; Put this file into your load-path and add (load "dired-cd") to
  81. ;; your dired-load-hook, e.g.
  82. ;;
  83. ;; (setq dired-load-hook '(lambda ()
  84. ;;               ;; possibly more statements here
  85. ;;              (load "dired-cd")))
  86. ;;
  87. ;; Do (setq dired-cd-same-subdir t) and perhaps (setq dired-cd-on-each t)
  88. ;; in your .emacs.  By default, dired-cd doesn't change the behavior of 
  89. ;; dired when it is loaded. 
  90. ;;
  91. ;; If dired-cd-same-subdir is non-nil, then the shell commands cd to
  92. ;; the appropriate directory if all the selected files (marked,
  93. ;; numeric ARG, etc.) are in that directory; however, on-each behavior
  94. ;; is not changed.
  95. ;;
  96. ;; If dired-cd-on-each is non-nil, then each instance of the command
  97. ;; for an on-each shell command runs in the file's directory
  98. ;; regardless of whether the files are all in the same directory.
  99.  
  100.  
  101. (defvar dired-cd-same-subdir nil
  102.   "*If non-nil, and selected file(s) (by marks, numeric arg, \\[universal-argument]) are in same
  103. subdir, causes dired shell command to run in that subdir.  Filenames provided
  104. to shell commands are stripped of their directory components.  Does not
  105. affect behavior of on-each, for that see variable dired-cd-on-each.")
  106.  
  107. (defvar dired-cd-on-each nil
  108.   "*If non-nil, on-each causes each dired shell command to run in the 
  109. file's directory.  Filenames provided to shell commands are stripped of 
  110. their directory components.  Also see variable dired-cd-same-subdir.")
  111.  
  112. ;; Redefines dired.el's version.
  113. ;; Changes to documentation and prompt, and uses dired-cd-wrap-it.
  114. (defun dired-do-shell-command (&optional arg in-background)
  115.   "Run a shell command on the marked files.
  116. If there is output, it goes to a separate buffer.
  117. The list of marked files is appended to the command string unless asterisks
  118.   `*' indicate the place(s) where the list should go.
  119. If no files are marked or a specific numeric prefix arg is given, uses
  120.   next ARG files.  With a zero argument, run command on each marked file
  121.   separately: `cmd * foo' results in `cmd F1 foo; ...; cmd Fn foo'.
  122.   As always, a raw arg (\\[universal-argument]) means the current file.
  123. The option variables dired-cd-same-subdir and dired-cd-on-each
  124.   permit the command\(s\) to run in the files' directories if appropriate,
  125.   and thus determine where output files are created.  Default is top
  126.   directory.  The prompt mentions the file(s) or the marker, the cd subdir,
  127.   and the on-each flags when they apply.
  128. No automatic redisplay is attempted, as the file names may have
  129.   changed.  Type \\[dired-do-redisplay] to redisplay the marked files."
  130.   ;; Function dired-shell-stuff-it (called by dired-cd-wrap-it) does the
  131.   ;; actual file-name substitution and can be redefined for customization.
  132.   (interactive "P")
  133.   (let* ((on-each (equal arg 0))
  134.      (file-list (dired-mark-get-files t (if on-each nil arg)))
  135.      (prompt (concat (if in-background "& " "! ")
  136.              (if (or (and on-each dired-cd-on-each)
  137.                  (and dired-cd-same-subdir
  138.                       (not on-each)
  139.                       (dired-files-same-directory file-list)))
  140.                  "cd <dir>; " "")
  141.              "on "
  142.              (if on-each "each " "")
  143.              "%s: "))
  144.      ;; Give feedback on file(s) and working directory status
  145.      (command (dired-read-shell-command
  146.            prompt (if on-each nil arg) file-list))
  147.      (result (dired-cd-wrap-it command file-list on-each arg)))
  148.     ;; execute the shell command
  149.     (dired-run-shell-command result in-background)))
  150.  
  151. (defun dired-cd-wrap-it (command files on-each &optional raw)
  152.   "Args COMMAND FILES ON-EACH &optional RAW-ARG, like dired-shell-stuff-it.
  153. Calls dired-shell-stuff-it, but wraps the resulting command\(s\)
  154. with \"cd <dir>\" commands when appropriate.  Note: when ON-EACH is non-nil, 
  155. dired-shell-stuff-it is called once for each file in FILES.
  156. See documentation of variables dired-cd-same-subdir and dired-cd-on-each 
  157. for wrap conditions." 
  158.   (if on-each;; command applied to each file separately
  159.       ;; cd's are done in subshells since all shells I know of have subshells
  160.       (let* ((cwd "");; current working directory
  161.          (in-subshell nil)
  162.          (cmd (mapconcat;; files over command, fuss with "cd <dir>"
  163.            (function
  164.             (lambda (file)
  165.               (let ((cd "") d);; cd command and file's directory
  166.             (if (not dired-cd-on-each) nil;; poor man's (when ...)
  167.               (setq d;; directory, relative to default-directory
  168.                 (directory-file-name 
  169.                  (or (file-name-directory file) ""))
  170.                 file (file-name-nondirectory file))
  171.               (if (not (string= d cwd));; new subdir, new subshell
  172.                   (setq cwd d
  173.                     ;; close existing subshell, 
  174.                     ;; open a new one
  175.                     cd (concat (if in-subshell "); " "") 
  176.                            "(cd " (shell-quote cwd) "; ")
  177.                     in-subshell t))
  178.               )
  179.             ;; existing dired-shell-stuff-it does 
  180.             ;; actual command substitution
  181.             (concat cd (dired-shell-stuff-it command (list file) 
  182.                              on-each raw)))))
  183.            files "; ")))
  184.     (if in-subshell (concat cmd ")") cmd));; close an open subshell
  185.     
  186.     ;; not on-each, all files are args to single command instance
  187.     (let ((same-dir (and dired-cd-same-subdir
  188.              (dired-files-same-directory files nil)))
  189.       (cd ""))
  190.       ;; Let the prepended cd command be relative to default-directory,
  191.       ;; and only give it if necessary.  This way, after ange-ftp
  192.       ;; prepends its own cd command, it will still work.
  193.       ;; sk  3-Sep-1991 14:23
  194.       ;; hsw 31-Oct-1991 -- filenames relative to default-directory
  195.       (if (and same-dir (not (equal same-dir "")))
  196.       (setq files (mapcar (function file-name-nondirectory) files)
  197.         cd  (concat "cd " (shell-quote same-dir) "; ")))
  198.       ;; existing dired-shell-stuff-it does the command substitution
  199.       (concat cd (dired-shell-stuff-it command files on-each raw)))))
  200.  
  201. (defun dired-files-same-directory (file-list &optional absolute)
  202.   "If all files in LIST are in the same directory return it, otherwise nil.
  203. Returned name has no trailing slash.  \"Same\" means file-name-directory of
  204. the files are string=.  File names in LIST must all be absolute or all be
  205. relative.  Implicitly, relative file names are in default-directory.  If
  206. optional ABS is non-nil, the returned name will be absolute, otherwise the
  207. returned name will be absolute or relative as per the files in LIST."
  208.   (let ((dir (file-name-directory (car file-list))))
  209.     (if (memq nil (mapcar (function
  210.                (lambda (file)
  211.                  (string= dir (file-name-directory file))))
  212.               file-list))
  213.     nil
  214.       (directory-file-name
  215.        (if (or (not absolute) (and dir (file-name-absolute-p dir)))
  216.        (or dir "")
  217.      (concat default-directory dir))))))
  218.  
  219. (provide 'dired-cd)
  220.